perm filename PPCODE.SAI[PNT,HE]2 blob sn#456535 filedate 1979-07-10 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00007 ENDMK
C⊗;
ENTRY;
BEGIN "PPCODE"
DEFINE $$PRGID=TRUE, $PPCODE=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;

DEFINE II=0;
DEFINE MAKEOP(OPNUM,OPNAM)"[]"=
	[ REDEFINE II = II + 2 ;
	DEFINE OPNUM = II ; ];

COMMENT REQUIRE "MOVE.DEF[PNT,HE]" SOURCE_FILE;
REQUIRE "INTOPS.SAI" SOURCE_FILE;

DEFINE #ALINTOPS = II ;
REQUIRE "[][]" DELIMITERS;
DEFINE III =["not valid"];
REDEFINE MAKEOP(OPNUM,OPNAM) = [REDEFINE III=cvms(III)&[,"]&CVPS(OPNAM)&["];];
REQUIRE "INTOPS.SAI" SOURCE_FILE;
PRESET_WITH III;
STRING ARRAY SPCODE[0:#ALINTOPS/2];

SIMPLE INTEGER PROCEDURE PCODE(STRING S);
BEGIN	INTEGER I;
	FOR I←#ALINTOPS/2 STEP -1 UNTIL 1 DO IF EQU(S,SPCODE[I]) THEN RETURN(I);
	RETURN(0);
END;

SIMPLE STRING PROCEDURE SCODE(INTEGER I);
	IF I MOD 2 = 0 AND 0≤I≤#ALINTOPS THEN RETURN(SPCODE[I/2])
		ELSE RETURN(SPCODE[0]);

INTERNAL PROCEDURE PPCODE(RPTR(EXPR$)EE;INTEGER SNUM(1));
BEGIN
	! program to print out pcode from number form to pcode form;
	INTEGER INDEX,INDEXF;

	PROCEDURE RPRINT;
	BEGIN
		PRINT("	",RFVAL(EXPR$:BODY[EE][INDEX+1],
				EXPR$:BODY[EE][INDEX+2]));
		INDEX←INDEX+2;
	END;

!	PROCEDURE LPRINT;
!		PRINT("	.+ ",EXPR$:BODY[EE][INDEX←INDEX+1]-GRINCH2);

	PROCEDURE OPRINT;
		PRINT("	",CVOS(EXPR$:BODY[EE][INDEX←INDEX+1]));

	PROCEDURE DPRINT;
		PRINT("	.+ ",EXPR$:BODY[EE][INDEX←INDEX+1],"(D)");

	PROCEDURE NPCODE;
	BEGIN
		INTEGER I,J;
		I←EXPR$:BODY[EE][INDEX←INDEX+1]/2;
		J←EXPR$:BODY[EE][INDEX] MOD 2;
		IF J=0 AND 1≤I≤ARRINFO(SPCODE,2)
			THEN PRINT(CRLF,"	",SPCODE[I])
			ELSE PRINT(CRLF,"	",EXPR$:BODY[EE][INDEX],"(D)");
		IF J=0 THEN
		CASE I OF
		BEGIN
		    [XJUMP/2][XPRINT/2][XJUMPC/2][XFORCHK/2]
			DPRINT;
		    [XRJMP/2][XRPRINT/2][XRJMPC/2][XRFRCHK/2]
			DPRINT;
		    [XPUSHSCI/2]
			RPRINT;
		    [XAFFIX/2]
			BEGIN
			OPRINT;	OPRINT;	OPRINT;
			IF EXPR$:BODY[EE][INDEX] LAND '2000 THEN OPRINT;
			END;
		    [XAGTVAL/2][XACHNGE/2][XARTVAL/2]
			BEGIN OPRINT; OPRINT; END;
		    [XGTVAL/2][XCHNGE/2][XWHERE/2][XPUSHINTI/2][XKVAR/2]
		    [XGTBLK/2][XCOPY/2][XRETURN/2][XPROC/2][XREPLAC/2]
		    [XGATHER/2]
			OPRINT;
		    [XRCENTER/2][XRPMOVE/2]
		    [XRTADRIVE/2][XRTDDRIVE/2]
			BEGIN DPRINT; OPRINT; END;
		    [XMVAR/2]
			DO OPRINT UNTIL 
				EXPR$:BODY[EE][INDEX]=0;
		    [XAPUSHOFFSET/2]
			BEGIN OPRINT;OPRINT END;
		    [XPUSHOFFSET/2]
			OPRINT;
		    [XGTINT/2][XGVALS/2][XCHNGS/2]
		    [XPUNFIX]
			INDEX←INDEX;
		    [XPAFFIX/2] OPRINT;
		    ELSE INDEX←INDEX
		END;
		
	END;
	INDEX←SNUM-1;INDEXF←EXPR$:#BODY[EE];
	WHILE INDEX<INDEXF DO NPCODE;
END;

PROCEDURE PPPCODE;ppcode(null_record);
END;